home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTLINK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  35KB  |  1,247 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totLINK;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.        1.00a     Apr  2 91   Changed file read logic when only Directory
  13.                              requested in FileDLLOBJ.
  14.        1.00b     May 29 91   Corrected DelNode when nil pointer passed
  15.        1.00c     Jun 11 91   Allowed display of directories when mask <> '*.*'
  16.        1.00d     Oct 10 91   Reset vSorted when list modified
  17. }
  18.  
  19. INTERFACE
  20.  
  21. Uses DOS,CRT,
  22.      totSTR;
  23.  
  24. Const
  25.   NoFiles: string[20] = 'No Files';
  26.  
  27. Type
  28.  
  29. tFileInfo = record
  30.      FileName: string[12];
  31.      Attr: byte;
  32.      Time: longint;
  33.      Size: longint;
  34.      LoadID: longint;
  35. end; {tFileInfo}
  36.  
  37. DLLNodePtr = ^DLLNodeObj;
  38. pDLLNodeOBJ = ^DLLNodeOBJ;
  39. DLLNodeOBJ = Object         {this object is not extensible}
  40.    vNextPtr: DLLNodePtr;
  41.    vPrevPtr: DLLNodePtr;
  42.    vDataPtr: pointer;
  43.    vSize: longint;
  44.    vStatus: byte;   {selectable, selected}
  45.    {methods...}
  46.    procedure FreeData;
  47.    function  NextPtr: DLLNodePtr;
  48.    function  PrevPtr: DLLNodePtr;
  49.    function  GetStatus(BitPos:byte): boolean;
  50.    procedure SetStatus(BitPos:byte;On:boolean);
  51.    function  GetStatusByte: byte;
  52.    procedure SetStatusByte(Val:byte); 
  53. end; {DLLNodeOBJ}
  54.  
  55. DLLPtr = ^DLLOBJ;
  56. pDLLOBJ = ^DLLOBJ;
  57. DLLOBJ = Object
  58.    vStartNodePtr:  DLLNodePtr;
  59.    vEndNodePtr:    DLLNodePtr;
  60.    vActiveNodePtr: DLLNodePtr;
  61.    vTotalNodes:       longint;
  62.    vActiveNodeNumber: longint;
  63.    vSortID:           shortInt;
  64.    vSortAscending:    boolean;
  65.    vSorted:           boolean;
  66.    vMaxNodeSize :     longint;
  67.    {methods...}
  68.    constructor Init;
  69.    function    Add(var TheData;Size:longint): integer;
  70.    function    Change(Node:DLLNodePtr;var TheData;Size:longint): integer;
  71.    function    InsertBefore(Node:DLLNodePtr;var TheData;Size:longint): integer;
  72.    procedure   Get(var TheData);
  73.    procedure   GetNodeData(Node:DLLNodePtr;Var TheData);
  74.    function    GetNodeDataSize(Node:DLLNodePtr):longint;
  75.    function    GetMaxNodeSize: longint;
  76.    procedure   Advance(Amount:longint);
  77.    procedure   Retreat(Amount:longint);
  78.    function    NodePtr(NodeNumber:longint): DLLNodePtr;
  79.    procedure   Jump(NodeNumber:longint);
  80.    procedure   ShiftActiveNode(NewNode: DLLNodePtr; NodeNumber: longint);
  81.    procedure   DelNode(Node:DLLNodePtr);
  82.    procedure   DelAllStatus(BitPos:byte;On:boolean);
  83.    function    TotalNodes: longint;
  84.    function    ActiveNodeNumber: longint;
  85.    function    ActiveNodePtr: DLLNodePtr;
  86.    function    StartNodePtr: DLLNodePtr;
  87.    function    EndNodePtr: DLLNodePtr;
  88.    procedure   EmptyList;
  89.    procedure   Sort(SortID:shortint;Ascending:boolean);
  90.    function    WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
  91.    procedure   SwapNodes(Node1,Node2:DLLNodePtr);                       VIRTUAL;
  92.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;    VIRTUAL;
  93.    destructor  Done;
  94. end; {DLLOBJ}
  95.  
  96. StrDLLPtr = ^StrDLLOBJ;
  97. pStrDLLOBJ = ^StrDLLOBJ;
  98. StrDLLOBJ = object (DLLOBJ)
  99.    {methods ...}
  100.    constructor Init;
  101.    function    Add(Str:string): integer;
  102.    function    Change(Node:DLLNodePtr;Str: string): integer;
  103.    function    InsertBefore(Node:DLLNodePtr;Str:string): integer;
  104.    function    WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
  105.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;    VIRTUAL;
  106.    destructor  Done;
  107. end; {StrDLLOBJ}
  108.  
  109. FileDLLPtr = ^FileDLLOBJ; 
  110. pFileDLLOBJ = ^FileDLLOBJ;
  111. FileDLLOBJ = object (DLLOBJ)
  112.    vFileMasks: string;
  113.    vFileAttrib: word;
  114.    {methods ...}
  115.    constructor Init;
  116.    procedure   FillList;
  117.    procedure   SetFileDetails(FileMasks:string; FileAttrib: word);
  118.    procedure   FillNewMask(FileMasks:string);
  119.    function    GetLongStr(Node:DLLNodePtr):string;
  120.    procedure   GetFileRecord(var FileInfo:tFileInfo; Item:longint);
  121.    function    GetFileMask:string;
  122.    function    WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
  123.    procedure   SwapNodes(Node1,Node2:DLLNodePtr);                       VIRTUAL;
  124.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;    VIRTUAL;
  125.    destructor  Done;
  126. end; {FileDLLOBJ}
  127.  
  128. function Subdirectory(B : byte):boolean;
  129. function FileAttribs(B:byte):string;
  130. function LongName(Info: tFileInfo):string;
  131. procedure LINKInit;
  132.  
  133. IMPLEMENTATION
  134. {|||||||||||||||||||||||||||||||||||||||||||||}
  135. {                                             }
  136. {     M i s c.  P r o c s   &   F u n c s     }
  137. {                                             }
  138. {|||||||||||||||||||||||||||||||||||||||||||||}
  139. function Subdirectory(B : byte):boolean;
  140. begin
  141.    Subdirectory := ((B and Directory) = Directory);
  142. end; {Subdirectory}
  143.  
  144. function FileAttribs(B:byte):string;
  145. var
  146.   S : string;
  147. begin
  148.    S := '    ';
  149.    If ((B and ReadOnly) = Readonly) then
  150.       S[1] := 'R';
  151.    If ((B and Hidden) = Hidden) then
  152.       S[2] := 'H';
  153.    If ((B and SysFile) = SysFile) then
  154.       S[3] := 'S';
  155.    If ((B and Archive) = Archive) then
  156.       S[4] := 'A';
  157.    FileAttribs := S;
  158. end; {FileAttribs}
  159.  
  160. function LongName(Info: tFileInfo):string;
  161. {}
  162. var 
  163.   DT :datetime;
  164.   S: String;
  165. begin
  166.    S := padleft(Info.FileName,12,' ');
  167.    UnPackTime(Info.Time,DT);
  168.    if Subdirectory(Info.Attr) then                  {add file size}
  169.       S := S + Padright('<DIR>',8,' ')
  170.    else
  171.       S := S + Padright(InttoStr(Info.Size),8,' ');
  172.    S := S + ' ';
  173.    with DT do
  174.    begin
  175.       Case Month of        
  176.          1 : S := S + 'Jan ';
  177.          2 : S := S + 'Feb ';
  178.          3 : S := S + 'Mar ';
  179.          4 : S := S + 'Apr ';
  180.          5 : S := S + 'May ';
  181.          6 : S := S + 'Jun ';
  182.          7 : S := S + 'Jul ';
  183.          8 : S := S + 'Aug ';
  184.          9 : S := S + 'Sep ';
  185.          10: S := S + 'Oct ';
  186.          11: S := S + 'Nov ';
  187.          12: S := S + 'Dec ';
  188.       end; {case}
  189.       S := S + Padright(InttoStr(Day),2,'0')+','+IntToStr(Year)+' ';
  190.       if Hour > 12 then
  191.          S := S + Padright(IntToStr(Hour-12),2,' ')+':'+Padright(IntToStr(min),2,'0')+'p'
  192.       else
  193.          S := S + Padright(IntToStr(Hour),2,' ')+':'+Padright(IntToStr(min),2,'0')+'a';
  194.       S := S + ' '+FileAttribs(Info.Attr);
  195.    end;
  196.    LongName := S;
  197. end; {LongName}
  198. {||||||||||||||||||||||||||||||||||||||||||||||}
  199. {                                              }
  200. {     D L L  N o d e O b j   M E T H O D S     }
  201. {                                              }
  202. {||||||||||||||||||||||||||||||||||||||||||||||}
  203. procedure DLLNodeObj.FreeData;
  204. {}
  205. begin
  206.    if (vDataPtr <> Nil) and (vSize > 0) then
  207.    begin
  208.       Freemem(vDataPtr,vSize);
  209.       vDataPtr := nil;
  210.       vSize:= 0;
  211.    end;
  212. end; {DLLNodeObj.FreeData}
  213.  
  214. function DLLNodeObj.NextPtr: DLLNodePtr;
  215. {}
  216. begin
  217.    NextPtr := vNextPtr;
  218. end; {DLLNodeOBJ.NextPtr}
  219.  
  220. function DLLNodeObj.PrevPtr: DLLNodePtr;
  221. {}
  222. begin
  223.    PrevPtr := vPrevPtr;
  224. end; {DLLNodeOBJ.PrevPtr}
  225.  
  226. function DLLNodeObj.GetStatus(BitPos:byte): boolean;
  227. {}
  228. var TestByte: Byte;
  229. begin
  230.    if BitPos > 7 then
  231.       GetStatus := false
  232.    else
  233.    begin
  234.      Testbyte := vStatus;
  235.      TestByte := TestByte SHR BitPos; {move to end bit}
  236.      GetStatus := odd(TestByte);
  237.    end;
  238. end; {DLLNodeOBJ.GetStatus}
  239.  
  240. procedure DLLNodeObj.SetStatus(BitPos:byte; On:boolean);
  241. {}
  242. var
  243.    Test : integer;
  244. begin
  245.    if BitPos <= 7 then
  246.    begin
  247.       if On then
  248.       begin
  249.          Test := 1 SHL BitPos;
  250.          vStatus := vStatus or Test
  251.       end
  252.       else
  253.       begin
  254.          Test := not (1 SHL BitPos);
  255.          vStatus := vStatus and Test;
  256.       end;
  257.    end;
  258. end; { DLLNodeObj.SetStatus }
  259.  
  260. function DLLNodeObj.GetStatusByte: byte;
  261. {}
  262. begin
  263.    GetStatusByte := vStatus;
  264. end; {DLLNodeObj.GetStatusByte}
  265.  
  266. procedure DLLNodeObj.SetStatusByte(Val:byte);
  267. {}
  268. begin
  269.    vStatus := Val;
  270. end; {DLLNodeObj.SetStatusByte}
  271. {||||||||||||||||||||||